home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 25 / Cream of the Crop 25.iso / program / tmtp100d.zip / EXAMPLES / FLAME / FLAME1.PAS < prev   
Pascal/Delphi Source File  |  1996-08-21  |  3KB  |  61 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {       Copyright (C) 1996    T M T   Corporation       }
  4. {                                                       }
  5. {*******************************************************}
  6.  
  7. { this exaple demonstrate direct access to video memory }
  8. { and I/O port                                          }
  9.  
  10. { this program has been posted to COMP.LANG.PASCAL newsgroup.} 
  11. { Here is unchanged original version with author comments.   }
  12. { This program can't works under DOS32 extender             }    
  13.  
  14. { DOS version: Use Turbo Pascal 6.0+ to compile }
  15.  
  16. var c, x, y, z : Word;
  17. procedure setrgb( c, r, g, b : byte );
  18. begin
  19.   port[$3c8] := c;   { g'day, this is a probably the most simple version   }
  20.   port[$3c9] := r;   { of fire that you will ever see in pascal. i wrote   }
  21.   port[$3c9] := g;   { the code in pascal so it's slow and choppy, i have  }
  22.   port[$3c9] := b;   { another version in asm. and it's faster. anyways if }
  23. end;                 { you have any critics or question on this code, just }
  24.                      { e-mail me at ekd0840@bosoleil.ci.umoncton.ca. or    }
  25. begin                {              9323767@info.umoncton.ca               }
  26.   randomize;         {  note : I have code for all kinds of stuff (that I  }
  27.   asm   mov ax, 13h  {         wrote of course), if you want something     }
  28.         int 10h      {         e-mail me (i never get mail), maybe i have  }
  29.   end;               {         what you want.                              }
  30.   for x := 1 to 32 do{                               keith degrüce         }
  31.   begin              {                               moncton, n.-b. canada }
  32.     setrgb(x,   x*2-1, 0,     0    );
  33.     setrgb(x+32, 63,   x*2-1, 0    );
  34.     setrgb(x+64, 63,   63,    x*2-1);
  35.     setrgb(x+96, 63,   63,    63   );
  36.   end;
  37.   repeat
  38.    x := 0;
  39.    repeat
  40.      y := 60;
  41.      repeat
  42.        c := (mem[$a000:y * 320 + x]+
  43.              mem[$a000:y * 320 + x + 2]+
  44.              mem[$a000:y * 320 + x - 2]+
  45.              mem[$a000:(y+2) * 320 + x + 2]) div 4;
  46.        if c <> 0 then dec(c);
  47.        memw[$a000:(y-2) * 320 + x] := (c shl 8) + c;
  48.        memw[$a000:(y-1) * 320 + x] := (c shl 8) + c;
  49.        Inc(Y,2);
  50.      until y > 202;
  51.      Dec(y,2);
  52.      mem[$a000:y * 320 + x] := random(2) * 160;
  53.      Inc(X,2);
  54.     until x >= 320;
  55.   until port[$60] < $80;
  56.   asm  mov ax, 3
  57.        int 10h
  58.   end;
  59.  
  60. end.
  61.